home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / cad / mar93cad.zip / TIP850.LSP < prev    next >
Text File  |  1993-02-13  |  2KB  |  63 lines
  1. ; TIP850: BLO.LSP (c)1993, J. Todd Owen
  2. ; Changes all entities within selected block to layer 0
  3.  
  4. (defun C:BL0 (/ CL ENAME ENT)
  5.   (setvar "CMDECHO" 0)    
  6.   (setvar "HIGHLIGHT" 0)
  7.   (setq CL (getvar "CLAYER"))
  8.   (command ".LAYER" "S" "0" "")
  9.   (setq ENAME nil ENT nil)
  10.   (while (= ENAME nil)
  11.     (setq ENAME (car (entsel "\nSelect block to redefine on layer 0: ")))
  12.   )
  13.   (setq ENT (entget ENAME))
  14.   (if (= (ITEM 0 ENT) "INSERT")
  15.     (progn
  16.       (command ".COPY" ENAME "" "@" "@")
  17.       (setq ENAME (entlast))
  18.       (BLOCK0 ENAME)
  19.     )
  20.     (progn (princ "\nError: A block must be selected.") (C:BL0))
  21.   )
  22.   (command ".LAYER" "S" CL "")
  23.   (setvar "HIGHLIGHT" 1)
  24.   (setvar "CMDECHO" 1)
  25.   (princ)
  26. )
  27.  
  28. (defun BLOCK0 (ENAME / ENAME2 ENT INSPT BLKNAME SSBLK)
  29.   (setq ENT (entget ENAME))
  30.   (setq INSPT (ITEM 10 ENT))
  31.   (setq BLKNAME (ITEM 2 ENT))
  32.   (setq ENT (subst (cons 41 1) (assoc 41 ENT) ENT)) ;x-scale
  33.   (setq ENT (subst (cons 42 1) (assoc 42 ENT) ENT)) ;y-scale
  34.   (setq ENT (subst (cons 43 1) (assoc 43 ENT) ENT)) ;z-scale
  35.   (setq ENT (subst (cons 50 0) (assoc 50 ENT) ENT)) ;rotation angle
  36.   (entmod ENT)
  37.   (command ".EXPLODE" ENAME)
  38.   (setq ENAME (entnext ENAME))
  39.   (setq SSBLK (ssadd))
  40.   (while (/= ENAME nil)
  41.     (setq ENT (entget ENAME))
  42.     (setq ENT (subst (cons 8 "0") (assoc 8 ENT) ENT)) ;layer
  43.     (setq ENT (subst (cons 62 256) (assoc 62 ENT) ENT)) ;color
  44.     (setq ENT (subst (cons 6 "BYLAYER") (assoc 6 ENT) ENT)) ;ltype
  45.     (entmod ENT)
  46.     (setq SSBLK (ssadd ENAME SSBLK))
  47.     (if (= (ITEM 0 ENT) "INSERT") ;if ENAME is a block
  48.       (progn
  49.         (command ".COPY" ENAME "" "@" "@")
  50.         (setq ENAME2 (entlast))
  51.         (BLOCK0 ENAME2)
  52.       )
  53.     )
  54.     (setq ENAME (entnext ENAME))
  55.   )
  56.   (command ".BLOCK" BLKNAME "Y" INSPT SSBLK "")
  57. )
  58.  
  59. (defun ITEM (N ENT)
  60.   (cdr (assoc N ENT))
  61. )
  62. 
  63.